home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr53 / pctv4n_1.zip / DBWRAP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-10  |  9KB  |  352 lines
  1. unit dbwrap;
  2. interface
  3. uses EBAY60, Objects;
  4.  
  5. type
  6.     TEBAbstract = object
  7.        ID, Result : integer;
  8.     procedure   Error;
  9.     end;
  10.  
  11.     ErrorProcedure = procedure(ErrorCode: Integer);
  12.  
  13.     PEBField = ^TEBField;
  14.     TEBField = object(TEBAbstract)
  15.           Name  : NameStr;
  16.           Table : Integer;
  17.           ebType: Integer;
  18.        constructor Init(FieldName: Namestr; TableID: Integer);
  19.        function    AsInteger: Longint;
  20.        function    AsString : String;
  21.        procedure   GetData(var Data); virtual;
  22.        procedure   SetData(var Data); virtual;
  23.        procedure   Store(Data: String);
  24.        end;
  25.  
  26.     PEBView = ^TEBView;
  27.     TEBView = object(TEBAbstract)
  28.           Fields  : PCollection;
  29.           Index   : NDXArg;
  30.        constructor Init(db: integer; Tbl: NameStr;
  31.                         FldLst: String; NDX: NameStr);
  32.        destructor  Done; virtual;
  33.        procedure   Add;
  34.        function    Field(Name: NameStr): PEBField;
  35.        function    KeyFromString(S:String; var Key:KeyStr):integer;
  36.        function    Search(Item: String): Integer;
  37.        procedure   Store(Data: String);
  38.        procedure   Update;
  39.        end;
  40.  
  41.     PEBDatabase = ^TEBDatabase;
  42.     TEBDatabase = object(TEBAbstract)
  43.        constructor Init(N: NameStr);
  44.        function    View(Table: NameStr; Fields: String;
  45.                         Index: NameStr): PEBView;
  46.        destructor  Done; virtual;
  47.        end;
  48.  
  49.     TEBEngine = object(TEBAbstract)
  50.        constructor Init;
  51.        function    OpenDataBase(N: NameStr): PEBDatabase;
  52.        destructor  Done; virtual;
  53.        end;
  54.  
  55. const
  56.    ErrConversion    = -10000;
  57.    ErrUnimplemented = -10001;
  58.    parsechar : char = ',';
  59.    Messages  : array[0..1] of string =
  60.       ('Conversion error',
  61.        'Attempt to use unimplemented feature.');
  62. var
  63.    DatabaseError: ErrorProcedure;
  64. implementation
  65. const MonthStr = '  JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
  66.  
  67. { Utilities }
  68.  
  69. procedure Error(Code: Integer);
  70. begin
  71.    writeln('Error in database call:');
  72.    If Code = 0 then writeln('Emerald Bay Engine not loaded.')
  73.    else If Code < -10000 then
  74.    begin
  75.       writeln(Messages[Abs(Code)]);
  76.       dbExit;
  77.       end
  78.    else begin
  79.       writeln(ErrorMsg(Code));
  80.       dbExit;                  {Give engine chance to close tables.}
  81.       end;
  82.    Halt(1);
  83.    end;
  84.  
  85. function Parse(var S: String): string;   {WARNING: removes Parsed data}
  86. var B: byte;                                 {from "S" parameter}
  87. begin
  88.    B := pos(parsechar,S);
  89.    If B = 0 then B := length(S)+1;
  90.    Parse := copy(s,1,b-1);
  91.    Delete(s,1,B);
  92.    end;
  93.  
  94. function DateFromString(S: String): longint;
  95. var code, day, month, year: integer;
  96. begin
  97.    Val(copy(S,1,2), Day, Code);
  98.    Month := Pos(copy(s,3,3),MONTHSTR);
  99.    Val(Copy(S,5,4), Year, Code);
  100.    If (Day=0) or (Month=0) or (Year=0) then DateFromString := errConversion
  101.    else DateFromString := CalJul(Day, Month, Year);
  102.    end;
  103.  
  104. function IncidencesOf(C: Char; S: String): byte;
  105. var I, J : byte;
  106. begin
  107.    J := 0;
  108.    For I := 1 to Length(S) do if S[I] = C then Inc(J);
  109.    IncidencesOf := J;
  110.    end;
  111.  
  112. Function UpCaseString(S : string) : string;
  113. var I : byte;
  114. begin
  115.    for I := 1 to length(s) do s[i] := upcase(s[i]);
  116.    UpCaseString := s;
  117.    end;
  118. { Abstract }
  119. procedure TEBAbstract.Error;
  120. begin
  121.    DatabaseError(Result);
  122.    end;
  123. { Field Methods }
  124. constructor TEBField.Init;
  125. var FARG: FLDArg;
  126. begin
  127.    Table  := TableID;
  128.    Name   := UpcaseString(FieldName);
  129.    Result := dbGetNamedFieldInfo(Table, Name, Farg);
  130.    If Result>=0 then
  131.    begin
  132.       ID     := FArg.FldID;
  133.       ebType := Farg.FldType;
  134.       end
  135.    else Error;
  136.    end;
  137.  
  138. function    TEBField.AsInteger: longInt;
  139. var N: LongInt;
  140. begin
  141.    case EBType of
  142.       dTypLng, dTypDat: begin         {dates are stored as longints}
  143.          GetData(N);
  144.          AsInteger := N;
  145.          end;
  146.       else Result := errUnimplemented; {easily add string to integer}
  147.       end;                         {conversions by calling AsString}
  148.    If Result<0 then Error;             {then using Pascal's VAL proc}
  149.    end;
  150.  
  151. function    TEBField.AsString: string;
  152. var D: array[1..2048] of char;
  153. begin
  154.    GetData(D);
  155.    case ebType of
  156.       dTypStr: begin
  157.          MakeStr(D);                        {EB uses ASCIIZ strings}
  158.          AsString := String((@D)^);         {this converts/typecast}
  159.          end;
  160.       else Result := errUnimplemented;
  161.       end;
  162.    end;
  163.  
  164. procedure   TEBField.Store;
  165. var Code : integer;
  166.     L    : LongInt;
  167. begin
  168.    case EBType of
  169.       dTypStr: begin
  170.          cnvstr(data);
  171.          SetData(Data);
  172.          end;
  173.       dTypLng: begin
  174.          Val(Data, L, Code);
  175.          If Code<>0 then Result := errConversion
  176.          else SetData(L);
  177.          end;
  178.       dTypDat: begin
  179.          L := DateFromString(string((@Data)^)); {accepts only one                                      format}
  180.          If Result<>errConversion then SetData(L); {for dates                                   ddmmmyyyy}
  181.          end;
  182.       else Result := errUnimplemented;
  183.       end;
  184.    If Result<0 then Error;
  185.    end;
  186.  
  187. procedure   TEBField.GetData;
  188. begin
  189.    Result := DBFetch(Table,ID,Data);
  190.    If Result<0 then Error;
  191.    end;
  192.  
  193. procedure   TEBField.SetData;
  194. begin
  195.    Result := dbStore(Table, ID, Data);
  196.    If Result<0 then Error;
  197.    end;
  198.  
  199. { View methods }
  200.  
  201. constructor TEBView.Init(db: integer; Tbl: NameStr; FldLst: String; NDX:
  202. NameStr);
  203. var P: PEBField;
  204.     S: String;
  205.     N: Byte;
  206. begin
  207.    Result := dbOpenTable(db, Tbl);
  208.    If Result >= 0 then
  209.    begin
  210.       ID := Result;
  211.       N := IncidencesOf(ParseChar, FldLst) + 1;
  212.       Fields := New(PCollection, Init(N, 0));
  213.       repeat
  214.          P := New(PEBFIeld, Init(S, ID));
  215.          Result := P^.Result;
  216.          Fields^.Insert(P);
  217.          until (FldLst='') or (Result<0);
  218.       end;
  219.    If Result>=0 then
  220.    begin
  221.       Result := dbGetNamedIndexInfo(ID, NDX, Index);
  222.       If Result < 0 then Error;
  223.       end;
  224.    end;
  225.  
  226. destructor  TEBView.Done;
  227. begin
  228.    If Fields<>nil then Dispose(Fields, Done);
  229.    end;
  230.  
  231. procedure   TEBView.Add;
  232. begin
  233.    Result := dbAdd(ID);
  234.    If Result<0 then Error;
  235.    end;
  236.  
  237. function    TEBView.Field(Name: NameStr): PEBField;
  238. var I: Integer;
  239. begin
  240.    Field := Nil;
  241.    Name := UpcaseString(Name);
  242.    For I := 0 to Fields^.Count - 1
  243.      do if PEBField(Fields^.At(I))^.Name = Name
  244.      then Field := Fields^.At(I);
  245.    end;
  246.  
  247. function    TEBView.KeyFromString(S: String; var Key: KeyStr): integer;
  248. var Code, FID, Loop    : Integer;
  249.     L                  : LongInt;
  250.     Pattern, T         : String;
  251.     FArg               : FldArg;
  252.     Long               : array[0..MaxNDX] of LongInt;  {MaxNDX is 5}
  253.     KR                 : KeyRec;
  254. begin
  255.    Loop := 0;
  256.    Pattern := '';
  257.    repeat
  258.       T        := Parse(S);
  259.       FID      := Index.NDXAtr[Loop];
  260.       Result   := dbGetFieldInfo(ID, FId, Farg);
  261.       If Result>=0 then
  262.       begin
  263.          case FArg.FldType of
  264.             dTypLng: begin
  265.                Val(T, Long[Loop], Code);
  266.                KR[Loop] := @Long[Loop];
  267.                If Code<>0 then Result := errConversion;
  268.                Pattern := Pattern + 'l';
  269.                end;
  270.             else Result := errUnimplemented;
  271.             end;
  272.          end;
  273.       Inc(Loop);
  274.       until(Result<0) or (S='') or (Index.NDXAtr[Loop]=0);
  275.    If Result<0 then Error
  276.    else KeyFromString := dbMakeSearchKey(Key, Pattern, KR);
  277.    end;
  278.  
  279. function    TEBView.Search(Item: String): Integer;
  280. var K: KeyStr;
  281.     L: Integer;
  282. begin
  283.    L := KeyFromString(Item, K);
  284.    Result := dbSearch(ID, Index.NDXID, K, L, equal);
  285.    If Result<-1 then Error;
  286.    Search := Result;
  287.    end;
  288.  
  289. procedure   TEBView.Store(Data: String);
  290. var P    : PEBFIeld;
  291.     S, T : String;
  292.     L    : Integer;
  293. begin
  294.    L := 0;
  295.    repeat
  296.       P := Fields^.At(L);
  297.       T := Parse(Data);
  298.       If P<>nil then P^.Store(T);
  299.       inc(L);
  300.       until (P^.Result<0) or (Result<0);
  301.    If Result >= 0 then Result := P^.Result;
  302.    If Result<0 then Error;
  303.    end;
  304.  
  305. procedure   TEBView.Update;
  306. begin
  307.    Result := dbUpdate(ID);
  308.    If Result<0 then Error;
  309.    end;
  310.  
  311. { Database Methods }
  312.  
  313. constructor TEBDatabase.Init(N: NameStr);
  314. begin
  315.    Result := dbLogin(N, '');
  316.    ID := Result;
  317.    If Result<0 then Error;
  318.    end;
  319.  
  320. function    TEBDatabase.View(Table: NameStr; Fields: String; Index: NameStr):
  321. PEBView;
  322. var V: PEBView;
  323. begin
  324.    View := New(PEBView, Init(ID, Table, Fields, Index));
  325.    end;
  326.  
  327. destructor  TEBDatabase.Done;
  328. begin
  329.    Result := dbLogOut(ID);
  330.    end;
  331.  
  332. { Engine Methods }
  333.  
  334. constructor TEBEngine.Init;
  335. begin
  336.    Result := DBInit('admin');
  337.    If Result<=0 then Error;
  338.    end;
  339.  
  340. function    TEBEngine.OpenDataBase(N: NameStr): PEBDatabase;
  341. var D: PEBDatabase;
  342. begin
  343.    OpenDatabase := New(PEBDatabase, Init(N));
  344.    end;
  345.  
  346. destructor  TEBEngine.Done;
  347. begin
  348.    DBExit;
  349.    end;
  350.  
  351. end.
  352.